#-------------------------------------
# Description : Simulation of Log-Plya-Aeppli regression model
#-------------------------------------

library(nlme)
require(polyaAeppli)  # package of Plya-Aeppli distribution

#---------------------------------------
# Simulation
#---------------------------------------

n      = 200   # sample size 
nsim   = 1000 # simulations numbers

#---
# values of the parameters
#---

x      = rbinom(n,1,0.5)          # covariate
Xe     = model.matrix(~ 1 + x)

beta0  = 1.5
beta1  = 2.5
betae  = c(beta0,beta1)
rho    = 0.5
mu     = exp(Xe %*% betae)
lambda = mu*(1-rho)

parameters = c(betae,rho) 

#---
beta0.1 = beta1.1 = rho1 = numeric(nsim)
EQM.beta0.1 = EQM.beta1.1 = EQM.rho1 = numeric(nsim)
E.pad.beta0.1 = E.pad.beta1.1 = E.pad.rho1 = numeric(nsim)
inf.beta0.1 = inf.beta1.1 = inf.rho1 = numeric(nsim)
sup.beta0.1 = sup.beta1.1 = sup.rho1 = numeric(nsim)

LRS = numeric(nsim)

r_pearson = matrix(0, nrow = nsim, ncol = n)
Q.pearson = matrix(0, nrow = nsim, ncol = n)

#---------------------------------------
for (j in 1:nsim){# beginning for simulations

y  = rPolyaAeppli(n,lambda, rho)

#---
# likelihood function

f = function(theta1) {
  
  betae  = theta1[1:2]
  rho    = 1/(1+exp(-theta1[3])) 

  mu     = exp(Xe %*% betae)

  lambda = mu*(1-rho)	
 
  loglik   = dPolyaAeppli(y, lambda, rho, log = TRUE)

  sum(loglik)
}

#---
# Estimation

theta0 = c(-0.4,1.3,0.1)
m.IP   = optim(theta0, f, control = list(fnscale = -1, trace = FALSE, maxit = 10000),  method = "L-BFGS-B")

# Estimates

beta0.1[j] = m.IP$par[1]
beta1.1[j] = m.IP$par[2]
rho1[j]    = 1/(1+exp(-m.IP$par[3]))
betae1     = c(beta0.1[j],beta1.1[j])
mu1        = exp(Xe %*% betae1)

Estimates  = c(beta0.1[j],beta1.1[j],rho1[j])

#---
# Pearson residuos

for(i in 1:n){ r_pearson[j,i] = (y[i]-mu1[i])/sqrt(mu1[i]*(1+rho1[j])/(1-rho1[j]))}
Q.pearson[j,] <- sort(r_pearson[j,])


#---
# likelihood ratio statistics - Poisson (rho=0) vs Polya-Aeppli

log.vero_PO = -(AIC(glm(y~x,family="poisson"))-4)/2
log.vero_PA = m.IP$value

LRS[j] = -2*(log.vero_PO-log.vero_PA) 

#---
# Mean Square Error

EQM.beta0.1[j] = (beta0.1[j]-beta0)^2
EQM.beta1.1[j] = (beta1.1[j]-beta1)^2
EQM.rho1[j]    = (rho1[j]-rho)^2

#---
f1 = function(theta1) {
  
  betae  = theta1[1:2]
  rho    = theta1[3]

  mu     = exp(Xe %*% betae)

  lambda = mu*(1-rho)	
 
  loglik = dPolyaAeppli(y, lambda, rho, log = TRUE)

  sum(loglik)
}

#--
obsinf      = -fdHess(Estimates, f1)$Hessian
covmat      = solve(obsinf)
setheta     = sqrt(diag(covmat))
E.pad.beta0.1[j] = setheta[1]
E.pad.beta1.1[j] = setheta[2]
E.pad.rho1[j]    = setheta[3]

while (E.pad.rho1[j]=="NaN"){ # Incio while
y          = rPolyaAeppli(n,lambda, rho)
theta0     = c(-0.4,1.3,0.1)
m.IP       = optim(theta0, f, control = list(fnscale = -1, trace = FALSE, maxit = 10000),  method = "L-BFGS-B")
beta0.1[j] = m.IP$par[1]
beta1.1[j] = m.IP$par[2]
rho1[j]    = 1/(1+exp(-m.IP$par[3]))
betae1     = c(beta0.1[j],beta1.1[j])
mu1        = exp(Xe %*% betae1)
Estimates  = c(beta0.1[j],beta1.1[j],rho1[j])

for(i in 1:n){ r_pearson[j,i] = (y[i]-mu1[i])/sqrt(mu1[i]*(1+rho1[j])/(1-rho1[j]))}

Q.pearson[j,] <- sort(r_pearson[j,])

log.vero_PO = -(AIC(glm(y~x,family="poisson"))-4)/2
log.vero_PA = m.IP$value
LRS[j]      = -2*(log.vero_PO-log.vero_PA) 

EQM.beta0.1[j] = (beta0.1[j]-beta0)^2
EQM.beta1.1[j] = (beta1.1[j]-beta1)^2
EQM.rho1[j]    = (rho1[j]-rho)^2

obsinf      = -fdHess(Estimates, f1)$Hessian
covmat      = solve(obsinf)
setheta     = sqrt(diag(covmat))
E.pad.beta0.1[j] = setheta[1]
E.pad.beta1.1[j] = setheta[2]
E.pad.rho1[j]    = setheta[3]
} # fim while

#---
# confidence interval
inf.beta0.1[j] = beta0.1[j]-1.96*E.pad.beta0.1[j]
sup.beta0.1[j] = beta0.1[j]+1.96*E.pad.beta0.1[j]
inf.beta1.1[j] = beta1.1[j]-1.96*E.pad.beta1.1[j]
sup.beta1.1[j] = beta1.1[j]+1.96*E.pad.beta1.1[j]
inf.rho1[j]    = rho1[j]-1.96*E.pad.rho1[j]
sup.rho1[j]    = rho1[j]+1.96*E.pad.rho1[j]

} # End for simulations

#--------------------------------------------------
# Results
#--------------------------------------------------

vicio.Est = round(c(mean(beta0.1)-beta0,mean(beta1.1)-beta1,mean(rho1)-rho),3)
estimates = round(c(mean(beta0.1),mean(beta1.1),mean(rho1)),3)
E.Q.M     = round(c(sqrt(mean(EQM.beta0.1)),sqrt(mean(EQM.beta1.1)),sqrt(mean(EQM.rho1))),3)
result    = cbind(parameters,estimates,E.Q.M,vicio.Est)
result

#---
# coverage probabilty function

coverage = function(val.verd.param,nsim,lim.inf,lim.sup){

conta = 0
for(i in 1:nsim){ # incio for
ic = c(lim.inf[i],lim.sup[i])

if(val.verd.param>ic[1] & val.verd.param<ic[2])

conta = conta +1
} # fim for
return(conta/nsim)
}

coverage(beta0,length(beta0.1),inf.beta0.1,sup.beta0.1)
coverage(beta1,length(beta1.1),inf.beta1.1,sup.beta1.1)
coverage(rho,length(rho1),inf.rho1,sup.rho1)

#---
# Residuo

mean_pearson   = apply(Q.pearson,1,mean)
median_pearson = apply(Q.pearson,1,median)

# par(mfrow=c(2,2))
qqnorm(mean_pearson, main = expression(paste("n = 200 and ", rho, " = 0.5")))
# qqnorm(median_pearson, main = expression(paste("n = 200 and ", rho, " = 0.5")))


#---
# LRS function

Rejection.rate =  sum(ifelse(LRS>qchisq(0.95,1),1,0))/length(LRS)
Rejection.rate



